﻿Imports System.Runtime.InteropServices

Class GlassText
    'This class is copied from various sources found on Google

    Private Const DTT_COMPOSITED As Integer = CInt((1 << 13))
    Private Const DTT_GLOWSIZE As Integer = CInt((1 << 11))

#Region "Text format consts"
    Const DT_TOP As Long = &H0&                      'Justifies the text to the top of the rectangle.
    Const DT_LEFT As Long = &H0&                     'Aligns text to the left.
    Const DT_CENTER As Long = &H1&                   'Centers text horizontally in the rectangle.
    Const DT_RIGHT As Long = &H2&                    'Aligns text to the right.
    Const DT_VCENTER As Long = &H4&                  'Centers text vertically. This value is used only with the DT_SINGLELINE value.
    Const DT_BOTTOM As Long = &H8&                   'Justifies the text to the bottom of the rectangle. This value is used only with the DT_SINGLELINE value.
    Const DT_WORDBREAK As Long = &H10&               'Breaks words. Lines are automatically broken between words if a word would extend past the edge of the rectangle specified by the lpRect parameter. A carriage return-line feed sequence also breaks the line. If this is not specified, output is on one line.
    Const DT_SINGLELINE As Long = &H20&              'Displays text on a single line only. Carriage returns and line feeds do not break the line.
    Const DT_EXPANDTABS As Long = &H40&              'Expands tab characters. The default number of characters per tab is eight. The DT_WORD_ELLIPSIS, DT_PATH_ELLIPSIS, and DT_END_ELLIPSIS values cannot be used with the DT_EXPANDTABS value.
    Const DT_TABSTOP As Long = &H80&                 'Sets tab stops. Bits 158 (high-order byte of the low-order word) of the uFormat parameter specify the number of characters for each tab. The default number of characters per tab is eight. The DT_CALCRECT, DT_EXTERNALLEADING, DT_INTERNAL, DT_NOCLIP, and DT_NOPREFIX values cannot be used with the DT_TABSTOP value.
    Const DT_NOCLIP As Long = &H100&                 'Draws without clipping. DrawText is somewhat faster when DT_NOCLIP is used.
    Const DT_EXTERNALLEADING As Long = &H200&        'Includes the font external leading in line height. Normally, external leading is not included in the height of a line of text.
    Const DT_CALCRECT As Long = &H400&               'Determines the width and height of the rectangle. If there are multiple lines of text, DrawText uses the width of the rectangle pointed to by the lpRect parameter and extends the base of the rectangle to bound the last line of text. If the largest word is wider than the rectangle, the width is expanded. If the text is less than the width of the rectangle, the width is reduced. If there is only one line of text, DrawText modifies the right side of the rectangle so that it bounds the last character in the line. In either case, DrawText returns the height of the formatted text but does not draw the text.
    Const DT_NOPREFIX As Long = &H800&               'Turns off processing of prefix characters. Normally, DrawText interprets the mnemonic-prefix character & as a directive to underscore the character that follows, and the mnemonic-prefix characters && as a directive to print a single &. By specifying DT_NOPREFIX, this processing is turned off. For example, input string:"A&bc&&d", normal:"Abc&d", DT_NOPREFIX:"A&bc&&d". Compare with DT_HIDEPREFIX and DT_PREFIXONLY.
    Const DT_INTERNAL As Long = &H1000&              'Uses the system font to calculate text metrics.
    Const DT_EDITCONTROL As Long = &H2000&           'Duplicates the text-displaying characteristics of a multiline edit control. Specifically, the average character width is calculated in the same manner as for an edit control, and the function does not display a partially visible last line.
    Const DT_PATH_ELLIPSIS As Long = &H4000&         'For displayed text, replaces characters in the middle of the string with ellipses so that the result fits in the specified rectangle. If the string contains backslash (\) characters, DT_PATH_ELLIPSIS preserves as much as possible of the text after the last backslash. The string is not modified unless the DT_MODIFYSTRING flag is specified. Compare with DT_END_ELLIPSIS and DT_WORD_ELLIPSIS.
    Const DT_END_ELLIPSIS As Long = &H8000&          'For displayed text, if the end of a string does not fit in the rectangle, it is truncated and ellipses are added. If a word that is not at the end of the string goes beyond the limits of the rectangle, it is truncated without ellipses. The string is not modified unless the DT_MODIFYSTRING flag is specified. Compare with DT_PATH_ELLIPSIS and DT_WORD_ELLIPSIS.
    Const DT_MODIFYSTRING As Long = &H10000          'Modifies the specified string to match the displayed text. This value has no effect unless DT_END_ELLIPSIS or DT_PATH_ELLIPSIS is specified.
    Const DT_RTLREADING As Long = &H20000            'Layout in right-to-left reading order for bi-directional text when the font selected into the hdc is a Hebrew or Arabic font. The default reading order for all text is left-to-right.
    Const DT_WORD_ELLIPSIS As Long = &H40000         'Truncates any word that does not fit in the rectangle and adds ellipses. Compare with DT_END_ELLIPSIS and DT_PATH_ELLIPSIS.
#End Region

    Private Const SRCCOPY As Integer = &HCC0020
    Private Const BI_RGB As Integer = 0
    Private Const DIB_RGB_COLORS As Integer = 0

    Private Structure MARGINS
        Public m_Left As Integer
        Public m_Right As Integer
        Public m_Top As Integer
        Public m_Buttom As Integer
    End Structure

    Private Structure POINTAPI
        Public x As Integer
        Public y As Integer
    End Structure

    Private Structure DTTOPTS
        Public dwSize As UInteger
        Public dwFlags As UInteger
        Public crText As UInteger
        Public crBorder As UInteger
        Public crShadow As UInteger
        Public iTextShadowType As Integer
        Public ptShadowOffset As POINTAPI
        Public iBorderSize As Integer
        Public iFontPropId As Integer
        Public iColorPropId As Integer
        Public iStateId As Integer
        Public fApplyOverlay As Integer
        Public iGlowSize As Integer
        Public pfnDrawTextCallback As IntPtr
        Public lParam As Integer
    End Structure

    Private Structure RECT
        Public left As Integer
        Public top As Integer
        Public right As Integer
        Public bottom As Integer
    End Structure

    Private Structure BITMAPINFOHEADER
        Public biSize As Integer
        Public biWidth As Integer
        Public biHeight As Integer
        Public biPlanes As Short
        Public biBitCount As Short
        Public biCompression As Integer
        Public biSizeImage As Integer
        Public biXPelsPerMeter As Integer
        Public biYPelsPerMeter As Integer
        Public biClrUsed As Integer
        Public biClrImportant As Integer
    End Structure

    Private Structure RGBQUAD
        Public rgbBlue As Byte
        Public rgbGreen As Byte
        Public rgbRed As Byte
        Public rgbReserved As Byte
    End Structure

    Private Structure BITMAPINFO
        Public bmiHeader As BITMAPINFOHEADER
        Public bmiColors As RGBQUAD
    End Structure

    Private Declare Auto Function GetDC Lib "user32.dll" (ByVal hdc As IntPtr) As IntPtr
    Private Declare Auto Function SaveDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Integer
    Private Declare Auto Function ReleaseDC Lib "user32.dll" (ByVal hdc As IntPtr, ByVal state As Integer) As Integer
    Private Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As IntPtr
    <DllImport("gdi32.dll", ExactSpelling:=True)> _
    Private Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
    End Function
    Private Declare Auto Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Boolean
    Private Declare Auto Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Boolean
    <DllImport("gdi32.dll")> _
    Private Shared Function BitBlt(ByVal hdc As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, _
    ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As UInteger) As Boolean
    End Function

    Private Declare Unicode Function DrawThemeTextEx Lib "UxTheme.dll" (ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, _
    ByVal dwFlags As Integer, ByRef pRect As RECT, ByRef pOptions As DTTOPTS) As Integer
    Private Declare Auto Function DrawThemeText Lib "UxTheme.dll" (ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, _
    ByVal dwFlags1 As Integer, ByVal dwFlags2 As Integer, ByRef pRect As RECT) As Integer
    Private Declare Auto Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As IntPtr, ByRef pbmi As BITMAPINFO, ByVal iUsage As UInteger, ByVal ppvBits As Integer, ByVal hSection As IntPtr, ByVal dwOffset As UInteger) As IntPtr

    Public Sub DrawTextOnGlass(ByVal hwnd As IntPtr, ByVal text As String, ByVal font As Font, ByVal ctlrct As Rectangle, ByVal iglowSize As Integer)
        Dim rc As New RECT()
        Dim rc2 As New RECT()

        rc.left = ctlrct.Left
        rc.right = ctlrct.Right + 2 * iglowSize - 20 'make it larger to contain the glow effect 
        rc.top = ctlrct.Top
        rc.bottom = ctlrct.Bottom + 2 * iglowSize

        'Just the same rect with rc,but (0,0) at the lefttop 
        rc2.left = 0
        rc2.top = 0
        rc2.right = rc.right - rc.left
        rc2.bottom = rc.bottom - rc.top

        Dim destdc As IntPtr = GetDC(hwnd) 'hwnd must be the handle of form,not control 
        Dim Memdc As IntPtr = CreateCompatibleDC(destdc) ' Set up a memory DC where we'll draw the text. 
        Dim bitmap As IntPtr
        Dim bitmapOld As IntPtr = IntPtr.Zero
        Dim logfnotOld As IntPtr

        Dim uFormat As Integer = DT_WORDBREAK Or DT_LEFT Or DT_TOP Or DT_NOPREFIX 'text format 
        Dim dib As New BITMAPINFO()
        dib.bmiHeader.biHeight = -(rc.bottom - rc.top) ' negative because DrawThemeTextEx() uses a top-down DIB 
        dib.bmiHeader.biWidth = rc.right - rc.left
        dib.bmiHeader.biPlanes = 1
        dib.bmiHeader.biSize = Marshal.SizeOf(GetType(BITMAPINFOHEADER))
        dib.bmiHeader.biBitCount = 32
        dib.bmiHeader.biCompression = BI_RGB
        If Not SaveDC(Memdc) = 0 Then
            bitmap = CreateDIBSection(Memdc, dib, DIB_RGB_COLORS, 0, IntPtr.Zero, 0)
            ' Create a 32-bit bmp for use in offscreen drawing when glass is on 
            If Not (bitmap = IntPtr.Zero) Then
                bitmapOld = SelectObject(Memdc, bitmap)
                Dim hFont As IntPtr = font.ToHfont()
                logfnotOld = SelectObject(Memdc, hFont)
                Try
                    Dim renderer As New System.Windows.Forms.VisualStyles.VisualStyleRenderer(System.Windows.Forms.VisualStyles.VisualStyleElement.Window.Caption.Active)
                    Dim dttOpts As New DTTOPTS()
                    dttOpts.dwSize = CUInt(Marshal.SizeOf(GetType(DTTOPTS)))
                    dttOpts.dwFlags = DTT_COMPOSITED Or DTT_GLOWSIZE
                    dttOpts.iGlowSize = iglowSize
                    DrawThemeTextEx(renderer.Handle, Memdc, 0, 0, text, -1, uFormat, rc2, dttOpts)
                    BitBlt(destdc, rc.left, rc.top, rc.right - rc.left, rc.bottom - rc.top, Memdc, 0, 0, SRCCOPY)
                Catch e As Exception
                    Trace.WriteLine(e.Message)
                End Try


                'Remember to clean up 
                SelectObject(Memdc, bitmapOld)
                SelectObject(Memdc, logfnotOld)
                DeleteObject(bitmap)
                DeleteObject(hFont)
                ReleaseDC(Memdc, -1)
                DeleteDC(Memdc)
            End If
        End If
    End Sub
End Class